home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / batchut / rap101.zip / KEYMENU.RAP < prev    next >
Text File  |  1988-11-01  |  4KB  |  129 lines
  1. r: keymenu.rap - Put up array-based menu, respond to single keystrokes
  2.  
  3. ;    This is a fairly complex example showing some use of
  4. ;      arrays, ansi codes, as, special keys, and xi.
  5.  
  6. if $screentype <> "ansi"
  7.     t:Sorry... you'll need the ANSI.SYS driver installed for this program.
  8.     bye
  9. end if
  10.  
  11. $bold=*chr(27)[1m       ; highlight text
  12. $norm=*chr(27)[0m       ; normal text
  13. $save=*chr(27)[s        ; save cursor position
  14. $restore=*chr(27)[u     ; restore cursor position
  15. $beep=*chr(7)           ; sound bell
  16. $hide=*chr(27)[26;1H    ; hide cursor off-screen
  17.  
  18. $month[1]=January       ; The options are in an arbitrary-length array.
  19. $month[2]=February      ; Its name is also arbitrary.
  20. $month[3]=March         ; When we call *achoose, we'll provide name and length.
  21. $month[4]=April
  22. $month[5]=May
  23. $month[6]=June
  24. $month[7]=July
  25. $month[8]=August
  26. $month[9]=September
  27. $month[10]=October
  28. $month[11]=November
  29. $month[12]=December
  30.  
  31. proc main                            ; example of a procedure that uses achoose
  32.     loop
  33.         #choice=*achoose("month",12,7)        ;array name, length, default
  34.         exit if #choice = 0
  35.  
  36.         foot:You picked $month[#choice].
  37.     end loop
  38.  
  39.     ca 20,1
  40.     t:So long!
  41.  
  42. end proc
  43.  
  44.  
  45.    ; *achoose - Provide menu based on text array, respond to single keystrokes
  46.    ;            Highlight current selection (starting with default)
  47.    ;            F1 - F10 give options 1-10, Home gives 1, End gives last,
  48.    ;            Up/Left arrows decrement choice, Down/Right arrows increment
  49.    ;            Return "takes" the current selection.  Escape bails out.
  50.  
  51. num function *achoose($name,#nmax,#default)
  52.  
  53.     declare #n,#old,#c,#paged
  54.  
  55.     cls
  56.  
  57.     loop for #n = 1 to #nmax                ; Display all the options
  58.         th:*gospot(#n) *getm($name,#n)
  59.     end loop
  60.  
  61.     #n = #default                           ; Highlight the default
  62.     th:*gospot(#n)$save$bold *getm($name,#n) $norm
  63.  
  64.     loop
  65.         #old = #n
  66.  
  67.         as:#c                        ; Get a keystroke (as an ascii number)
  68.         if #c == 0                   ; Special keys produce null and second char
  69.             as:#c                    ;  so get the second char
  70.  
  71.             if #c == 72 or #c == 75         ; Up or left arrow
  72.                 #n--
  73.  
  74.             else if #c == 80 or #c == 77    ; Down or right arrow
  75.                 #n++
  76.  
  77.             else if #c == 71                ; Home
  78.                 #n = 1
  79.  
  80.             else if #c == 79                ; End
  81.                 #n = #nmax
  82.  
  83.             else if #c >= 59 and #c <= 68   ; Function keys
  84.                 #n = #c-58
  85.  
  86.             else                            ; Unknown
  87.                 th:$beep                    ;  beep
  88.  
  89.             end if
  90.  
  91.         else                           ; non-zero key - a normal keystroke
  92.  
  93.             if #c==10 or #c==13            ; Return or linefeed
  94.                 return #n
  95.  
  96.             else if #c==27                 ; Escape - bail out
  97.                 return 0
  98.  
  99.             else
  100.                 th:$beep               ; Invalid - beep
  101.                 repeat
  102.  
  103.             end if
  104.         end if
  105.  
  106.         if #n < 1                          ; keep n in limits
  107.             #n = #nmax
  108.  
  109.         else if #n > #nmax
  110.             #n = 1
  111.  
  112.         end if
  113.                                         ; change the highlight
  114.         th:$restore *getm($name,#old) *gospot(#n)$save$bold *getm($name,#n) $norm$hide
  115.  
  116.     end loop
  117.  
  118. end function
  119.  
  120. string function *gospot(#n)        ; go to the spot for a given selection
  121.     declare #row
  122.     #row = #n+2
  123.     return "*chr(27)[#row;10\H"
  124. end function
  125.  
  126. string function *getm($name,#sub)  ; get member given plain array name,subscript
  127.     xi:return "\$$name\[#sub]"
  128. end function
  129.